home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / misc / emu / QDOS2.lha / QLsource / ROMsrc / KBD / KBD_asm
Text File  |  1995-08-30  |  34KB  |  1,728 lines
  1.     SECTION    KBD
  2.  
  3.     INCLUDE    '/INC/QDOS_inc'
  4.     INCLUDE    '/INC/AMIGA_inc'
  5.     INCLUDE    '/INC/AMIGQDOS_inc'
  6.  
  7. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  8. ; KBD1_asm - Keyboard routines
  9. ;      - last modified 30/08/95
  10.  
  11. ; These are all the necessary keyboard related sources, required
  12. ; to implement QDOS keyboard routines on the Amiga computer.
  13.  
  14. ; Amiga-QDOS sources by Rainer Kowallik
  15. ;  ...latest changes by Mark J Swift
  16.  
  17. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  18. ;  ROM header
  19.  
  20. BASE:
  21.     dc.l    $4AFB0001    ; ROM recognition code
  22.     dc.w    PROC_DEF-BASE    ; add BASIC procs here
  23.     dc.w    ROM_START-BASE
  24.     dc.b    0,36,'Amiga-QDOS KEYBOARD routines v1.25 ',$A
  25.  
  26. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  27. ;  start of ROM code
  28.  
  29. ROM_START:
  30.     movem.l    d0-d3/a0-a3,-(a7)
  31.  
  32. ; --------------------------------------------------------------
  33. ;  allocate memory for keyboard variables
  34.  
  35.     move.l    #KV_LEN,d1
  36.     moveq    #MT.ALCHP,d0
  37.     moveq    #0,d2
  38.     trap    #1
  39.  
  40. ; --------------------------------------------------------------
  41. ;  address of keyboard variables
  42.  
  43.     move.l    a0,AV.KEYV
  44.     move.l    a0,a3
  45.  
  46. ; --------------------------------------------------------------
  47. ;  enter supervisor mode and disable interrupts
  48.  
  49.     trap    #0
  50.  
  51.     ori.w    #$0700,sr    ; disable interrupts
  52.  
  53. ; --------------------------------------------------------------
  54. ;  link a custom routine into level 7 interrupt server
  55.  
  56.     lea    AV.LVL7link,a1
  57.     lea    KV.LVL7link(a3),a2
  58.  
  59.     move.l    (a1),(a2)
  60.     move.l    a2,(a1)
  61.  
  62.     lea    MY_LVL7(pc),a1
  63.     move.l    a1,$04(a2)
  64.  
  65. ; --------------------------------------------------------------
  66. ;  link a custom routine into Trap #1 exception
  67.  
  68.     lea    AV.TRP1link,a1
  69.     lea    KV.TRP1link(a3),a2
  70.  
  71.     move.l    (a1),(a2)
  72.     move.l    a2,(a1)
  73.  
  74.     lea    MY_TRP1(pc),a1
  75.     move.l    a1,$04(a2)
  76.  
  77. ; --------------------------------------------------------------
  78. ;  initialise relevant hardware
  79.  
  80.     bsr    INIT_HW
  81.  
  82. ; -------------------------------------------------------------
  83. ; link in external interrupt to act on keyboard press
  84.  
  85.     lea    XINT_SERver(pc),a1 ; address of routine
  86.     lea    KV.XINTLink(a3),a0
  87.     move.l    a1,4(a0)
  88.     moveq    #MT.LXINT,d0
  89.     trap    #1
  90.  
  91. ; --------------------------------------------------------------
  92. ;  link in polled task routine to handle keyboard
  93.  
  94.     lea    POLL_SERver(pc),a1 ; address of routine
  95.     lea    KV.POLLLink(a3),a0
  96.     move.l    a1,4(a0)     ; address of polled task
  97.     moveq    #MT.LPOLL,d0
  98.     trap    #1
  99.  
  100. ; --------------------------------------------------------------
  101. ;  enable interrupts and re-enter user mode
  102.  
  103.     andi.w    #$D8FF,sr
  104.  
  105. ; --------------------------------------------------------------
  106. ROM_EXIT:
  107.     movem.l    (a7)+,d0-d3/a0-a3
  108.     rts
  109.  
  110. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  111. ;  initialise keyboard for use.
  112.  
  113. INIT_HW:
  114.     movem.l    d0-d2/a0/a3,-(a7)
  115.  
  116. ; --------------------------------------------------------------
  117. ;  set ASCII table and clear actual key.
  118.  
  119.     move.l    AV.KEYV,a3    ; address of keyboard vars
  120.  
  121.     lea    QLASCII(pc),a0
  122.     move.l    a0,KV.QLASCtbl(a3)
  123.  
  124.     clr.w    KV.ACTKEy(a3)    ; reset actual key
  125.  
  126.     move.w    #0,KV.PTRMINX(a3)
  127.     move.w    #0,KV.PTRMINY(a3)
  128.     move.w    #255,KV.PTRMAXX(a3)
  129.     move.w    #255,KV.PTRMAXY(a3)
  130.  
  131.     move.w    #0,KV.PTROLDX(a3)
  132.     move.w    #0,KV.PTROLDY(a3)
  133.  
  134.     move.w    #0,KV.PTRX(a3)
  135.     move.w    #0,KV.PTRY(a3)
  136.  
  137.     move.w    #4,KV.PTRINCX(a3)
  138.     move.w    #8,KV.PTRINCY(a3)
  139.  
  140. ; --------------------------------------------------------------
  141. ;  initialise hardware
  142.  
  143.     move.b    CIAA_ICR,d0    ; read & clear CIA-A ICR
  144.     or.b    AV.CIAA_ICR,d0
  145.     bclr    #3,d0        ; clear SP bit
  146.     move.b    d0,AV.CIAA_ICR    ; store for another program
  147.  
  148.     move.w    #%0000000000001000,INTREQ ; clear and enable
  149.     move.w    #%1000000000001000,INTENA ; CIA-A interrupts
  150.  
  151.     move.b    #%10001000,CIAA_ICR ; enable SP interrupt
  152.  
  153.     ori.b    #%00001000,AV.CIAA_MSK ; take note
  154.  
  155.     movem.l    (a7)+,d0-d2/a0/a3
  156.     rts
  157.  
  158. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  159. ;  external interrupt server
  160.  
  161. XINT_SERver:
  162.     movem.l    d7/a0,-(a7)
  163.  
  164.     move.w    INTENAR,d7    ; read interrupt enable reg
  165.     btst    #3,d7        ; branch if ints not on
  166.     beq    XINT_OTHer
  167.  
  168.     move.w    INTREQR,d7    ; read interrupt request reg
  169.     btst    #3,d7        ; branch if from CIA-A or
  170.     bne    CIAA_SERV    ; expansion ports
  171.  
  172. ; --------------------------------------------------------------
  173. ;  otherwise let another external interrupt server handle it
  174.  
  175. XINT_OTHer:
  176.     movem.l    (a7)+,d7/a0
  177.     rts
  178.  
  179. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  180. ;  Interrupt from CIA-A or expansion port
  181.  
  182. CIAA_SERV:
  183.     move.b    CIAA_ICR,d7    ; read CIA-A ICR
  184.     or.b    AV.CIAA_ICR,d7
  185.     move.b    d7,AV.CIAA_ICR    ; store for another program
  186.  
  187.     bclr    #3,d7        ; keyboard? (SP bit=1)
  188.     beq    XINT_OTHer    ; no
  189.  
  190. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  191. ; external interrupt server for acting on an a key press.
  192. ; The Result is stored in KV.ACTKEy (word) (MSB=ASCII,LSB=ALT)
  193.  
  194. RDKEYB:
  195.     move.b    d7,AV.CIAA_ICR
  196.  
  197.     and.b    AV.CIAA_MSK,d7    ; don't clear intreq if
  198.     bne.s    RDKEYB0        ; other CIAA ints occured
  199.  
  200.     move.w    #%0000000000001000,INTREQ ; clear interrupts
  201.  
  202. ; --------------------------------------------------------------
  203. RDKEYB0:
  204.     movem.l    d0/a0/a3,-(a7)
  205.  
  206.     move.l    AV.KEYV,a3    ; address of keyboard vars
  207.  
  208.     BSR    KEYread
  209.  
  210.     tst.b    KV.ACTKEy+1(a3)
  211.     beq    RDKEYBX
  212.  
  213. ; --------------------------------------------------------------
  214. ;  Check for CTRL-ALT-2 and simulate a level 2 interrupt
  215.  
  216. RDKEYB1:
  217.     move.w    KV.ACTKEy(a3),d0
  218.     cmp.w    #$92FF,d0    ; CTRL 2/ALT ?
  219.     bne.s    RDKEYB2
  220.  
  221.     clr.w    KV.ACTKEy(a3)    ; reset keypress
  222.  
  223.     ori.w    #$0700,sr    ; mask out all interrupts
  224.  
  225.     move.w    #$8000,d7
  226.  
  227. WAITABIT2:
  228.     move.w    #RED,COLOR00    ; signal forced interrupt
  229.     move.w    #0,COLOR00    ; via DMA-test pattern
  230.     dbra    d7,WAITABIT2
  231.  
  232.     adda.l    #$24,a7        ;*/note JS specific
  233.     movem.l    (a7)+,d0-d6/a0-a4 ; drop out of external
  234.     movem.l    (a7)+,d7/a5/a6    ; interrupt call
  235.  
  236.     subq.l    #4,a7
  237.     movem.l    a3,-(a7)
  238.     move.l    AV.MAINlink,a3
  239.     move.l    4(a3),4(a7)    ; address of 1st routine
  240.     movem.l    (a7)+,a3
  241.     rts            ; jump to routine
  242.  
  243. ; --------------------------------------------------------------
  244. ;  Check for CTRL-ALT-5 and simulate a level 5 interrupt
  245.  
  246. RDKEYB2:
  247.     move.w    KV.ACTKEy(a3),d0
  248.     cmp.w    #$95FF,d0    ; CTRL 5/ALT ?
  249.     bne.s    RDKEYB3
  250.  
  251.     clr.w    KV.ACTKEy(a3)    ; reset keypress
  252.  
  253.     ori.w    #$0700,sr    ; mask out all interrupts
  254.  
  255.     move.w    #$8000,d7
  256.  
  257. WAITABIT5:
  258.     move.w    #CYAN,COLOR00    ; signal forced interrupt
  259.     move.w    #0,COLOR00    ; via DMA-test pattern
  260.     dbra    d7,WAITABIT5
  261.  
  262.     adda.l    #$24,a7        ;*/note JS specific
  263.     movem.l    (a7)+,d0-d6/a0-a4 ; drop out of external
  264.     movem.l    (a7)+,d7/a5/a6    ; interrupt call
  265.  
  266.     subq.l    #4,a7
  267.     movem.l    a3,-(a7)
  268.     move.l    AV.LVL5link,a3
  269.     move.l    4(a3),4(a7)    ; address of 1st routine
  270.     movem.l    (a7)+,a3
  271.     rts            ; jump to routine
  272.  
  273. ; --------------------------------------------------------------
  274. ;  Check for CTRL-ALT-7 and simulate a level 7 interrupt
  275.  
  276. RDKEYB3:
  277.     move.w    KV.ACTKEy(a3),d0
  278.     cmp.w    #$97FF,d0    ; CTRL 7/ALT ?
  279.     bne.s    RDKEYB4
  280.  
  281.     clr.w    KV.ACTKEy(a3)    ; reset keypress
  282.  
  283.     ori.w    #$0700,sr    ; mask out all interrupts
  284.  
  285.     move.b    #$7F,CIAA_ICR    ; no ints from CIA-A
  286.     move.b    #$7F,CIAB_ICR    ; no ints from CIA-B
  287.     move.w    #$7FFF,INTREQ    ; clear interrupt requests
  288.     move.w    #$7FFF,INTENA    ; disable interrupts
  289.  
  290. ALT7_BZY:
  291.     btst    #6,DMACONR    ; wait for blitter
  292.     bne.s    ALT7_BZY
  293.  
  294.     move.w    #$07FF,DMACON    ; no DMA, no blitter prio'ty
  295.  
  296.     move.w    #$8000,d7
  297.  
  298. WAITABIT7:
  299.     move.w    #WHITE,COLOR00    ; signal forced interrupt
  300.     move.w    #0,COLOR00    ; via DMA-test pattern
  301.     dbra    d7,WAITABIT7
  302.  
  303.     adda.l    #$24,a7        ;*/note JS specific
  304.     movem.l    (a7)+,d0-d6/a0-a4 ; drop out of external
  305.     movem.l    (a7)+,d7/a5/a6    ; interrupt call
  306.  
  307.     subq.l    #4,a7
  308.     movem.l    a3,-(a7)
  309.     move.l    AV.LVL7link,a3
  310.     move.l    4(a3),4(a7)    ; address of 1st routine
  311.     movem.l    (a7)+,a3
  312.     rts            ; jump to routine
  313.  
  314. ; --------------------------------------------------------------
  315. ;  Check for CTRL-SHIFT-ALT-TAB and perform a reset
  316.  
  317. RDKEYB4:
  318.     move.l    KV.SHIFTflg(a3),d0
  319.     cmp.l    #(%00000111<<24)|$09FF,d0 ; ALT/CTRL/SHIFT/TAB/ALT
  320.     bne.s    RDKEYB5
  321.  
  322.     clr.w    KV.ACTKEy(a3)    ; reset keypress
  323.  
  324.     ori.w    #$0700,sr    ; mask out all interrupts
  325.  
  326.     move.b    #$7F,CIAA_ICR    ; no ints from CIA-A
  327.     move.b    #$7F,CIAB_ICR    ; no ints from CIA-B
  328.     move.w    #$7FFF,INTREQ    ; clear interrupt requests
  329.     move.w    #$7FFF,INTENA    ; disable interrupts
  330.  
  331. ALTT_BZY:
  332.     btst    #6,DMACONR    ; wait for blitter
  333.     bne.s    ALTT_BZY
  334.  
  335.     move.w    #$07FF,DMACON    ; no DMA, no blitter prio'ty
  336.  
  337.     movem.l    (a7)+,d0/a0/a3
  338.     movem.l    (a7)+,d7
  339.  
  340.     move.l    $0,a7        ; reset supervisor stack
  341.  
  342.     move.l    $4,-(a7)     ; call first reset routine
  343.     rts
  344.  
  345. ; --------------------------------------------------------------
  346. RDKEYB5:
  347.  
  348. RDKEYBX:
  349.     movem.l    (a7)+,d0/a0/a3
  350.  
  351. ; -------------------------------------------------------------
  352. XINT_EXIt:
  353.  
  354.     bra    XINT_OTHer
  355.  
  356. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  357. ;  Subroutine to read keyboard value from hardware
  358.  
  359. KEYread:
  360.     movem.l    d0-d3/a0/a3,-(a7)
  361.  
  362.     move.l    AV.KEYV,a3    ; address of keyboard vars
  363.  
  364.     lea    CIAA,a0        ; now implement Keyboard
  365.     moveq    #0,d0        ; handshake according to
  366.     move.b    d0,CRA(a0)    ; ROM listing ($FE5478)
  367.     move.b    d0,CRA(a0)
  368.     move.b    #$40,CRA(a0)    ; switch off keyboard
  369.  
  370.     move.b    CIAA_SP,d0    ; read raw key code
  371.  
  372.     move.l    #$40,d2
  373. WTKEYB0:
  374.     nop
  375.     dbra    d2,WTKEYB0
  376.  
  377.     move.b    #$0,CIAA_CRA    ; switch on keyboard again
  378.  
  379.     MOVE.L    #255,D1
  380.     SUB.B    D0,D1        ; calculate key stroke
  381.     LSR.B    #1,D1
  382.     AND.W    #1,D0        ; only press/release bit
  383.  
  384. ; --------------------------------------------------------------
  385. ; first convert to QL raw key code
  386.  
  387.     LEA    QLRAWKEY(PC),A0
  388.     MOVEQ    #0,D2
  389.     MOVE.B    0(A0,D1.W),D2    ; get row and bit number
  390.     bge.s    KEYrd2b        ; branch on valid key
  391.  
  392.     clr.w    KV.ACTKEy(a3)    ; otherwise, reset actual key
  393.  
  394.     lea    KV.STORAwkey(a3),a0
  395.     clr.l    (a0)+
  396.     clr.l    (a0)+        ; invalidate KEYROW bits
  397.     clr.l    (a0)+
  398.     clr.l    (a0)+
  399.  
  400.     clr.w    $90(a6)        ; disable key repeat
  401.     bra    KEYrdX1
  402.  
  403. KEYrd2b:
  404.     MOVE.L    D2,D3
  405.     LSR.L    #4,D3        ; extract row number -> D3
  406.     AND.W    #$7,D3
  407.     AND.B    #$07,D2        ; extract bit number -> D2
  408.     lea    KV.STORAwkey(a3),a0
  409.     BSET    D2,0(A0,D3.W)
  410.     CMP.B    #1,D0        ; press or release ?
  411.     BEQ.S    KEYCVASC
  412.     BCLR    D2,0(A0,D3.W)
  413.  
  414. ; --------------------------------------------------------------
  415. ; now convert to ASCII
  416.  
  417. KEYCVASC:
  418.     MOVE.W    #$FFFE,D2    ; mask for AND
  419.     CMP.B    #$60,D1        ; shift/alt/amiga ?
  420.     BLT.S    KEYrd2        ; ...nope
  421.     CMP.B    #$62,D1        ; Caps lock ?
  422.     BNE.S    KEYrd2a          ...nope
  423.     CMP.B    #1,D0        ; Caps on or off ?
  424.     SEQ    D0
  425.     lea    SV_CAPS(a6),A0    ; address $28088
  426.     MOVE.B    D0,(A0)        ; set CAPS flag
  427.     BRA    KEYrdX
  428.  
  429. KEYrd2a:
  430.     AND.B    #$7E,D1        ; Don't distinguish
  431.                 ; right/left
  432.     CMP.B    #$60,D1        ; Shift ?
  433.     BEQ.S    KEYrd1
  434.     LSL.W    #1,D0        ; Bit 0 for Shift, 1 for
  435.                 ; ctrl
  436.     ROL.W    #1,D2
  437.     CMP.B    #$62,D1        ; CTRL ?
  438.     BEQ.S    KEYrd1
  439.     LSL.W    #1,D0        ; Bit 2 for Alt, 3 for Amiga
  440.     ROL.W    #1,D2
  441.     CMP.B    #$64,D1        ; ALT ?
  442.     BEQ.S    KEYrd1
  443.     LSL.W    #1,D0
  444.     ROL.W    #1,D2
  445.     CMP.B    #$66,D1        ; AMIGA ?
  446.     bne    KEYrdX        ; should never happen!
  447. KEYrd1:
  448.     lea    KV.SHIFTflg(a3),a0 ; get address of flag
  449.     AND.B    D2,(A0)        ; clear old status bit
  450.     OR.B    D0,(A0)        ; and set new status
  451.     andi.w    #$0F00,(a0)    ; only keep modifiers
  452.  
  453.     clr.w    KV.ACTKEy(a3)    ; reset actual key
  454.  
  455.     BRA    KEYrdX
  456.  
  457. ; --------------------------------------------------------------
  458. ;  convert keycode (D1) and write result to ACTkey
  459.  
  460. KEYrd2:
  461.     CMP.B    #1,D0        ; press or just release ?
  462.     BEQ.S    KEYrd3
  463.     clr.w    KV.ACTKEy(a3)    ; reset actual key
  464.     bra    KEYrdX
  465. KEYrd3:
  466.     lea    KV.SHIFTflg(a3),a0
  467.     MOVE.B    (A0),D2        ; get current status of
  468.                 ; Shift
  469.     MOVE.B    D2,D0        ; store for ALT check
  470.     AND.B    #$3,D2        ; don't bother with Alt or
  471.                 ; Amiga
  472.     move.l    KV.QLASCtbl(a3),a0 ; first try no shifts
  473.     CMP.B    #0,D2
  474.     BEQ.S    KEYrd4
  475.  
  476.     lea    $60(a0),a0    ; next try Shift only
  477.     CMP.B    #1,D2
  478.     BEQ.S    KEYrd4
  479.  
  480.     lea    $60(a0),a0    ; now try ctrl only
  481.     CMP.B    #2,D2
  482.     BEQ.S    KEYrd4
  483.  
  484.     lea    $60(a0),a0    ; must be <Ctrl>+<Shift>
  485.  
  486. KEYrd4:
  487.     andi.b    #%01111111,d0    ; assume 'special'
  488.     cmp.b    #$40,d1
  489.     bge.s    KEYrd5        ; ...skip if so
  490.  
  491.     ori.b    #%10000000,d0    ; indicate a-z, 0-9
  492.  
  493. KEYrd5:
  494.     move.b    d0,KV.SHIFTflg(a3)
  495.  
  496.     MOVE.B    0(A0,D1.W),D1    ; get ASCII value
  497.     lea    SV_CAPS(a6),a0    ; address $28088
  498.     TST.B    (A0)        ; check for CAPS lock
  499.     BEQ.S    KEYrd6
  500.     CMP.B    #'a',D1        ; check for lower case
  501.                 ; letter
  502.     BLT.S    KEYrd6
  503.     CMP.B    #'z',D1
  504.     BGT.S    KEYrd6
  505.     SUB.B    #32,D1        ; change to upper case
  506.                 ; letter
  507. KEYrd6:
  508.     lea    KV.ACTKEy(a3),a0
  509.     MOVE.B    D1,(A0)        ; Store new key
  510.     BTST    #2,D0        ; ALT flag set ?
  511.     SNE    D0
  512.     MOVE.B    D0,1(A0)     ; store ALT flag
  513.     MOVE.W    (A0),D0        ; check for ALT and cursor
  514.                 ; key
  515.     AND.W    #$E0FF,D0    ; don't bother with
  516.                 ; up,right,left,down
  517.     CMP.W    #$C0FF,D0    ; check for cursor key
  518.     BNE.S    KEYrd7
  519.     ADD.B    #1,(A0)        ; now make correct key code
  520.     CLR.B    1(A0)        ; and clear ALT flag
  521.  
  522. KEYrd7:
  523.     move.w    KV.ACTKEy(a3),d0
  524.     cmpi.b    #$FF,d0        ; if part of ALT combination
  525.     beq.s    KEYrdX        ; exit now & let polled int
  526.                 ; put key into Q
  527.  
  528.     bsr    POLL_K        ; otherwise put into Q
  529.  
  530. KEYrdX:
  531.     MOVE.W    $8C(A6),$90(A6)    ; delay -> count
  532.  
  533. KEYrdX1:
  534.     movem.l    (a7)+,d0-d3/a0/a3
  535.     RTS
  536.  
  537. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  538. ;  Polled interrupt routine to read the keyboard
  539.  
  540. POLL_SERver:
  541.  
  542.     move.l    AV.KEYV,a3    ; address of keyboard vars
  543.  
  544.     move.w    JOY0DAT,d0    ; get counter
  545.     move.w    KV.STOMOuse(a3),d5
  546.     move.w    #$8080,JOYTEST    ; preset for next time
  547.     move.w    JOY0DAT,KV.STOMOuse(a3)
  548.  
  549.     cmp.w    d5,d0
  550.     beq.s    POLL_K
  551.  
  552.     sub.b    d5,d0
  553.     move.b    d0,d1
  554.     ext.w    d1
  555.     beq.s    POLL_1
  556.  
  557.     add.w    KV.PTRX(a3),d1
  558.     move.w    KV.PTRERRX(a3),d3
  559.     bsr    PTR_CLPX
  560.     move.w    d1,KV.PTRX(a3)
  561.     move.w    d3,KV.PTRERRX(a3)
  562.  
  563. POLL_1:
  564.     ror.w    #8,d0
  565.     ror.w    #8,d5
  566.  
  567.     sub.b    d5,d0
  568.     move.b    d0,d2
  569.     ext.w    d2
  570.     beq.s    POLL_2
  571.  
  572.     add.w    KV.PTRY(a3),d2
  573.     move.w    KV.PTRERRY(a3),d4
  574.     bsr    PTR_CLPY
  575.     move.w    d2,KV.PTRY(a3)
  576.     move.w    d4,KV.PTRERRY(a3)
  577.  
  578. POLL_2:
  579.     move.w    KV.PTRX(a3),d1
  580.     move.w    KV.PTRY(a3),d2
  581.     bsr    PTR_POS
  582.  
  583. POLL_K:
  584.     MOVEA.L    $4C(A6),A2    ; SV.KEYQ Pointer to a
  585.                 ; keyboard queue
  586.  
  587.     MOVE.L    A2,D0
  588.     beq.s    POLL_EXIt    ; no con_ open
  589.  
  590.     tst.b    (a2)
  591.     blt.s    POLL_EXIt    ; eof
  592.  
  593. POLL_3:
  594.     move.l    KV.SHIFTflg(a3),d1 ; read Shift flags and
  595.                  ; ACTkey
  596.  
  597.     ROR.W    #8,D1        ; rotate ascii in position
  598.     cmp.b    #0,d1        ; any key pressed ?
  599.     bne.s    L02EEC        ; yup!
  600.  
  601. NOKEY:
  602.     CLR.W    $8A(A6)        ; reset Autorepeat buffer
  603.  
  604. POLL_EXIt:
  605.     rts
  606.  
  607. ; --------------------------------------------------------------
  608. L02EEC:
  609.     CMP.L    #(%00000010<<24)|$0020,D1 ; <CTL><SPC> ?
  610.     BEQ    DO_BREAK
  611.  
  612.     CMPI.W    #$00F9,D1    ; = <CTL><F5> freeze
  613.     BEQ    FREEZE
  614.  
  615.     SF    $33(A6)        ; screen status
  616.     CMP.W    $92(A6),D1    ; SV.CQCH Keyboard change
  617.     BEQ    CTRL_C        ; queue character code
  618.  
  619.     CMP.W    $8A(A6),D1    ; New Key ?
  620.     BEQ.S    AREPOLD
  621.  
  622.     MOVE.W    D1,$8A(A6)    ; store Key
  623.     MOVE.W    $8C(A6),$90(A6)    ; delay -> count
  624.     BRA.S    AREPDO
  625.  
  626. ; --------------------------------------------------------------
  627. AREPOLD:
  628.     cmp.w    #1,SV_POLLM(a6)    ; no key repeat if part of
  629.     bgt    POLL_EXIt    ; a 'poll miss' time-slice
  630.  
  631.     MOVE.W    $90(A6),D2    ; get actual count
  632.     tst.w    d2
  633.     beq.s    POLL_EXIt    ; exit if key-repeat disabled
  634.  
  635.     SUBQ.W    #1,D2        ; decrement count
  636.     MOVE.W    D2,$90(A6)    ; and store new value
  637.     TST.W    D2        ; 0 reached ?
  638.     bne    POLL_EXIt    ; do nothing if not
  639.  
  640.     MOVE.W    $8E(A6),$90(A6)    ; SV.ARFRQ Autorepeat
  641.                 ; 1/frequency
  642.  
  643.     move.l    d1,d3        ; save key-stroke
  644.     move.w    IO.QTEST,a3
  645.     jsr    (a3)
  646.     beq    POLL_EXIt    ; exit if queue not empty
  647.  
  648.     move.l    d3,d1        ; restore key-stroke
  649.  
  650. ; --------------------------------------------------------------
  651. AREPDO:
  652.     cmpi.w    #$FF0A,d1    ; <ALT>-<RTN>
  653.     beq.s    DO_HISTORY
  654.  
  655.     cmpi.l    #(%00000010<<24)|$0009,d1 ; <CTL>-<TAB>
  656.     beq.s    DO_FLIP
  657.  
  658.     ror.w    #8,d1
  659.  
  660.     CMPI.B    #$FF,D1        ; <ALT> key ?
  661.     BNE.S    L02F36
  662.  
  663.     SWAP    D1
  664.     move.w    IO.QTEST,a3
  665.     jsr    (a3)
  666.  
  667.     CMPI.W    #2,D2
  668.     BLT    POLL_EXIt
  669.  
  670.     SWAP    D1
  671.     move.w    IO.QIN,a3    ; put a byte (D1) into a
  672.     jsr    (a3)        ; queue (A2)
  673.  
  674. L02F36:
  675.     LSR.W    #8,D1
  676.     move.w    IO.QIN,a3    ; put a byte (D1) into a
  677.     jsr    (a3)        ; queue (A2)
  678.  
  679.     bra    POLL_EXIt
  680.  
  681. ; --------------------------------------------------------------
  682. DO_HISTORY:
  683.  
  684.     move.l    Q_NEXTIN(a2),a3
  685.     cmp.l    Q_NXTOUT(a2),a3
  686.     bne    POLL_EXIt
  687.  
  688.     lea    $10(a2),a4
  689.  
  690. DO_HLUP1:
  691.     cmp.l    a4,a3
  692.     bne.s    DO_HIS1
  693.  
  694.     move.l    Q_END(a2),a3
  695.  
  696. DO_HIS1:
  697.     cmp.b    #$0A,-(a3)
  698.     beq.s    DO_HIS2
  699.  
  700.     cmp.l    Q_NXTOUT(a2),a3
  701.     bne.s    DO_HLUP1
  702.  
  703.     bra    POLL_EXIt
  704.  
  705. DO_HIS2:
  706.     move.l    a3,Q_NEXTIN(a2)
  707.     move.l    a3,Q_NXTOUT(a2)
  708.  
  709. DO_HLUP2:
  710.     cmp.l    a4,a3
  711.     bne.s    DO_HIS3
  712.  
  713.     move.l    Q_END(a2),a3
  714.  
  715. DO_HIS3:
  716.     cmp.b    #$0A,-(a3)
  717.     bne.s    DO_HLUP2
  718.  
  719. DO_HIS4:
  720.     addq.l    #1,a3
  721.     cmpa.l    Q_END(a2),a3
  722.     blt.s    DO_HIS5
  723.  
  724.     lea    $10(a2),a3
  725.  
  726. DO_HIS5:
  727.     move.l    a3,Q_NXTOUT(a2)
  728.  
  729.     bra    POLL_EXIt
  730.  
  731. ; --------------------------------------------------------------
  732. DO_FLIP:
  733.     bsr    FLIPIT
  734.     bra    POLL_EXIt
  735.  
  736. FLIPIT:
  737.     moveq    #0,d0
  738.     move.b    SV_MCSTA(a6),d0
  739.  
  740.     swap    d1
  741.     lsl.w    #4,d0
  742.     move.b    d0,d1
  743.     andi.b    #%10100000,d1
  744.     lsr.b    #2,d1
  745.     andi.b    #%01010000,d0
  746.     or.b    d1,d0
  747.     lsl.b    #1,d0
  748.     lsr.w    #4,d0
  749.     swap    d1
  750.  
  751.     eori.b    #1<<MC..SCRN,d0    ; flip between screen 1/2
  752.     move.b    d0,SV_MCSTA(a6)
  753.     andi.b    #%10001010,d0
  754.     move.b    d0,MC_STAT    ; switch screen if necessary
  755.  
  756.     rts
  757.  
  758. ; --------------------------------------------------------------
  759. DO_BREAK:
  760.     CLR.W    KV.ACTKEy(A3)    ; reset BREAK request
  761.     SF    $33(A6)        ; screen status
  762.  
  763.     MOVEA.L    $68(A6),A3    ; SV.JBBAS Pointer to base of
  764.                 ; job table
  765.     MOVEA.L    (A3),A3
  766.     SF    $F7(A3)
  767.     MOVE.W    $14(A3),D0    ; job status (BASIC)
  768.     BEQ.S    L02EEA        ; not suspended
  769.     MOVE.B    $13(A3),D0    ; priority of BASIC
  770.     BNE.S    BRECON1
  771.     MOVE.B    #$20,$13(A3)    ; set priority to 32 if it
  772.                 ; was set to 0
  773. BRECON1:
  774.     CLR.W    $14(A3)        ; release job
  775.     MOVE.L    $0C(A3),D0    ; pointer to byte which will
  776.                 ; be cleared when job relea
  777.     BEQ.S    L02EEA
  778.     MOVEA.L    D0,A3        ; clear this byte
  779.     SF    (A3)
  780.  
  781. L02EEA:
  782.     bra    POLL_EXIt
  783.  
  784. ; --------------------------------------------------------------
  785. FREEZE:
  786.     CLR.W    KV.ACTKEy(A3)    ; reset FREEZE request
  787.     NOT.B    $33(A6)        ; Screen status
  788.  
  789.     bra    POLL_EXIt
  790.  
  791. ; --------------------------------------------------------------
  792. CTRL_C:
  793.     CLR.W    KV.ACTKEy(A3)    ; reset CTRL_C request
  794.  
  795. SWITCHQ:
  796.     bsr    FNDCHN        ; find channel base/ID
  797.  
  798.     TST.B    SD_CURF(A1)    ; queue waiting ?
  799.     BGE.S    L02F54        ; cursor active
  800.  
  801.     BSR    SD_CURE        ; reactivate cursor
  802.  
  803. L02F54:
  804.     MOVEA.L    (A2),A2        ; next queue
  805.  
  806.     bsr    FNDCHN        ; find channel base/ID
  807.  
  808.     TST.B    SD_CURF(A1)    ; next queue active ?
  809.     BNE.S    CTRLC0        ; yup, continue
  810.  
  811.     CMPA.L    SV_KEYQ(A6),A2    ; Current key Q
  812.     BNE.S    L02F54        ; next Q <> this Q
  813.  
  814. CTRLC0:
  815.     move.b    SV_MCSTA(a6),d0
  816.  
  817.     cmp.l    #$20000,SD_SCRB(a1)
  818.     bne.s    CTRLC1
  819.  
  820.     andi.b    #$FF-(1<<MC..SCRN),d0
  821.     bra.s    CTRLC2
  822.  
  823. CTRLC1:
  824.     cmp.l    #$28000,SD_SCRB(a1)
  825.     bne.s    CTRLC3
  826.  
  827.     ori.b    #1<<MC..SCRN,d0
  828.  
  829. CTRLC2:
  830.     cmp.b    SV_MCSTA(a6),d0
  831.     beq.s    CTRLC3
  832.  
  833.     bsr    FLIPIT        ; switch screen if necessary
  834.  
  835. CTRLC3:
  836.     MOVE.L    A2,SV_KEYQ(A6)    ; set current keyboard queue
  837.     CLR.W    $AA(A6)        ; flashing cursor status
  838.                 ; (word)
  839.     MOVEQ    #6,D6
  840.  
  841.     bra    POLL_EXIt
  842.  
  843. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  844. SD_CURE:
  845.     movem.l    d0-d1/d3/a0-a2,-(a7)
  846.  
  847.     move.l    a1,a0
  848.     jsr    $1B86
  849.  
  850.     movem.l    (a7)+,d0-d1/d3/a0-a2
  851.     rts
  852.  
  853.     movem.l    d0-d1/d3/a1-a2,-(a7)
  854.  
  855.     moveq    #-1,d3
  856.     moveq    #SD.CURE,d0
  857.     trap    #3
  858.  
  859.     movem.l    (a7)+,d0-d1/d3/a1-a2
  860.     rts
  861.  
  862. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  863. ; Entry: A2 = pointer to keyboard queue
  864.  
  865. ; Exit:    A0 = Channel ID
  866. ;    A1 = Channel base
  867.  
  868. FNDCHN:
  869.     movem.l    d0-d1/a3-a4,-(a7)
  870.  
  871.     move.l    SV_CHBAS(a6),a0
  872.     move.l    SV_CHTOP(a6),a4
  873.     moveq    #0,d0
  874.  
  875. FNDLUP:
  876.     move.l    (a0),a1        ; channel vars?
  877.     cmpa.l    a1,a2
  878.     blt.s    FNDCNT
  879.  
  880.     move.l    (a1),d1
  881.     lea    0(a1,d1.w),a3
  882.     cmpa.l    a3,a2
  883.     blt.s    FNDDUN
  884.  
  885. FNDCNT:
  886.     addq.w    #1,d0
  887.     addq.l    #4,a0
  888.     cmp.l    a0,a4
  889.     bgt.s    FNDLUP
  890.  
  891.     suba.l    a1,a1
  892.     moveq    #0,d0
  893.     bra.s    FNDXIT        ; not found!
  894.  
  895. FNDDUN:
  896.     swap    d0
  897.     move.w    CH_TAG(a1),d0
  898.     swap    d0
  899.  
  900. FNDXIT:
  901.     move.l    d0,a0        ; channel ID
  902.  
  903.     movem.l    (a7)+,d0-d1/a3-a4
  904.  
  905.     rts
  906.  
  907. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  908. ;  Custom LVL7 routine to initialise hardware
  909.  
  910. MY_LVL7:
  911.     bsr    INIT_HW
  912.  
  913.     subq.l    #4,a7
  914.     movem.l    a3,-(a7)
  915.     move.l    AV.KEYV,a3
  916.     move.l    KV.LVL7link(a3),a3
  917.     move.l    4(a3),4(a7)    ; address of next routine
  918.     movem.l    (a7)+,a3
  919.  
  920.     rts
  921.  
  922. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  923. ;  A patch to replace TRAP#1 calls to: MT_IPCOM (d0=$11)
  924. ;  and to add the new routine MT_ASC (d0=$27)
  925.  
  926. MY_TRP1:
  927.     bsr    INI_A5A6
  928.  
  929.     cmp.b    #$11,d0
  930.     beq    MT_IPCOM
  931.  
  932.     cmp.b    #$27,d0
  933.     beq    MT_ASC
  934.  
  935. MY_TRP1X:
  936.     movem.l    (a7)+,d7/a5/a6    ; restore registers
  937.  
  938.     subq.l    #4,a7
  939.     movem.l    a3,-(a7)
  940.     move.l    AV.KEYV,a3
  941.     move.l    KV.TRP1link(a3),a3
  942.     move.l    4(a3),4(a7)    ; address of next routine
  943.     movem.l    (a7)+,a3
  944.  
  945.     rts
  946.  
  947. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  948. ; initialise A5 and A6 prior to performing a TRAP routine
  949.  
  950. INI_A5A6
  951.     SUBQ.L    #8,A7
  952.     MOVE.L    8(A7),-(A7)
  953.     MOVEM.L    D7/A5/A6,4(A7)
  954.  
  955.     move.l    a7,d7
  956.     andi.l    #$FFFF8000,d7
  957.     move.l    d7,a6        ; Calc address of sys vars
  958.  
  959.     LEA    4(A7),A5     ; A5 points to saved
  960.                 ; Registers D7,A5,A6
  961.     MOVEQ    #$7F,D7
  962.     AND.L    D7,D0
  963.     RTS
  964.  
  965. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  966. ;  TRAP #1 with D0=$11
  967.  
  968. MT_IPCOM:
  969.     cmp.b    #9,(a3)        ; is IPC command keyrow ?
  970.     bne    MY_TRP1X
  971.  
  972.     MOVEM.L    D4/D6-D7/A0-A1/A3,-(A7)
  973.  
  974.     MOVE.B    6(A3),D7     ; get row number
  975.     AND.W    #$7,D7        ; only 0..7 are valid
  976.     BSR    KEYROW
  977.     CMP.B    #1,D7        ; row 1 ? (contains arrows,
  978.                 ; space and enter)
  979.     bne    IPCOM_EX
  980.     TST.B    D1        ; any key pressed ?
  981.     beq    IPCOM_MO     ; no
  982.  
  983.     move.b    d1,d0
  984.     andi.b    #$96,d0
  985.     beq    IPCOM_EX
  986.  
  987.     movem.l    d1-d6/a3,-(a7)
  988.  
  989.     move.l    AV.KEYV,a3    ; address of keyboard vars
  990.  
  991.     move.w    KV.PTRX(a3),d1
  992.     move.w    KV.PTRY(a3),d2
  993.     move.w    KV.PTROLDX(a3),d5
  994.     move.w    KV.PTROLDY(a3),d6
  995.  
  996.     btst.b    #4,d0
  997.     beq.s    IPCOM_1
  998.     add.w    KV.PTRINCX(a3),d1
  999.     add.w    KV.PTRINCX(a3),d5
  1000.  
  1001. IPCOM_1:
  1002.     btst.b    #1,d0
  1003.     beq.s    IPCOM_2
  1004.     sub.w    KV.PTRINCX(a3),d1
  1005.     sub.w    KV.PTRINCX(a3),d5
  1006.  
  1007. IPCOM_2:
  1008.     btst.b    #7,d0
  1009.     beq.s    IPCOM_3
  1010.     add.w    KV.PTRINCY(a3),d2
  1011.     add.w    KV.PTRINCY(a3),d6
  1012.  
  1013. IPCOM_3:
  1014.     btst.b    #2,d0
  1015.     beq.s    IPCOM_4
  1016.     sub.w    KV.PTRINCY(a3),d2
  1017.     sub.w    KV.PTRINCY(a3),d6
  1018.  
  1019. IPCOM_4:
  1020.     bsr    PTR_CLPX
  1021.     bsr    PTR_CLPY
  1022.  
  1023.     move.w    d1,KV.PTRX(a3)
  1024.     move.w    d2,KV.PTRY(a3)
  1025.  
  1026.     bsr    PTR_POS
  1027.  
  1028.     move.w    d5,d1
  1029.     move.w    d6,d2
  1030.  
  1031.     bsr    PTR_CLPX
  1032.     bsr    PTR_CLPY
  1033.  
  1034.     move.w    d1,KV.PTROLDX(a3)
  1035.     move.w    d2,KV.PTROLDY(a3)
  1036.  
  1037.     movem.l    (a7)+,d1-d6/a3
  1038.  
  1039.     bra.s    IPCOM_EX
  1040.  
  1041. IPCOM_MO:
  1042.     BSR    MOUSE
  1043.  
  1044. IPCOM_EX:
  1045.     MOVEM.L    (A7)+,D4/D6-D7/A0-A1/A3
  1046.     moveq    #0,d0
  1047.     bra    TRAP1_X
  1048.  
  1049. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1050. ;  KEYROW emulation (row number in D7, -> Columns in D1)
  1051.  
  1052. KEYROW:
  1053.     MOVEM.L    A0,-(A7)
  1054.  
  1055.     move.l    AV.KEYV,a0    ; address of keyboard vars
  1056.     lea    KV.STORAwkey(a0),a0
  1057.     AND.W    #$0F,D7
  1058.     MOVE.B    0(A0,D7.W),D1
  1059.  
  1060.     MOVEM.L    (A7)+,A0
  1061.     RTS
  1062.  
  1063. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1064. ; read mouse port and generate corresponding keydepression -> D1
  1065.  
  1066. MOUSE:
  1067.     MOVEM.L    D0/D2-D5/A0,-(A7)
  1068.  
  1069.     move.l    AV.KEYV,a0    ; address of keyboard vars
  1070.  
  1071.     clr.b    d1        ; preset 'no key'
  1072.  
  1073. ; --------------------------------------------------------------
  1074.     moveq    #0,d5
  1075.     move.w    KV.PTRINCX(a0),d5
  1076.  
  1077.     move.w    KV.PTRX(a0),d0
  1078.     sub.w    KV.PTRMINX(a0),d0
  1079.     add.w    KV.PTRERRX(a0),d0
  1080.     ext.l    d0
  1081.     bmi.s    MOUS1
  1082.  
  1083.     divu    d5,d0
  1084.     bra.s    MOUS2
  1085.  
  1086. MOUS1:
  1087.     neg.w    d0
  1088.     divu    d5,d0
  1089.     addq.w    #1,d0
  1090.     neg.w    d0
  1091.  
  1092. MOUS2:
  1093.     move.w    KV.PTROLDX(a0),d4
  1094.     sub.w    KV.PTRMINX(a0),d4
  1095.     ext.l    d4
  1096.     divu    d5,d4
  1097.  
  1098.     cmp.w    d4,d0        ; more or less ?
  1099.  
  1100.     bmi.s    MOUS3
  1101.     beq.s    MOUS4
  1102.  
  1103.     ori.b    #$10,d1        ; right
  1104.     addq.w    #1,d4
  1105.     bra.s    MOUS4
  1106.  
  1107. MOUS3:
  1108.     ori.b    #$02,d1        ; left
  1109.     subq.w    #1,d4
  1110.  
  1111. MOUS4:
  1112.     mulu    d5,d4
  1113.     add.w    KV.PTRMINX(a0),d4
  1114.     move.w    d4,KV.PTROLDX(a0)
  1115.  
  1116. ; --------------------------------------------------------------
  1117.     moveq    #0,d6
  1118.     move.w    KV.PTRINCY(a0),d6
  1119.  
  1120.     move.w    KV.PTRY(a0),d0
  1121.     sub.w    KV.PTRMINY(a0),d0
  1122.     add.w    KV.PTRERRY(a0),d0
  1123.     ext.l    d0
  1124.     bmi.s    MOUS5
  1125.  
  1126.     divu    d6,d0
  1127.     bra.s    MOUS6
  1128.  
  1129. MOUS5:
  1130.     neg.w    d0
  1131.     divu    d6,d0
  1132.     addq.w    #1,d0
  1133.     neg.w    d0
  1134.  
  1135. MOUS6:
  1136.     move.w    KV.PTROLDY(a0),d4
  1137.     sub.w    KV.PTRMINY(a0),d4
  1138.     ext.l    d4
  1139.     divu    d6,d4
  1140.  
  1141.     cmp.w    d4,d0        ; more or less ?
  1142.  
  1143.     bmi.s    MOUS7
  1144.     beq.s    MOUS8
  1145.  
  1146.     ori.b    #$80,d1        ; down
  1147.     addq.w    #1,d4
  1148.     bra.s    MOUS8
  1149.  
  1150. MOUS7:
  1151.     ori.b    #$04,d1        ; up
  1152.     subq.w    #1,d4
  1153.  
  1154. MOUS8:
  1155.     mulu    d6,d4
  1156.     add.w    KV.PTRMINY(a0),d4
  1157.     move.w    d4,KV.PTROLDY(a0)
  1158.  
  1159. ; --------------------------------------------------------------
  1160.     movem.l    d1/d3-d4,-(a7)
  1161.  
  1162.     move.w    KV.PTROLDX(a0),d1
  1163.     move.w    KV.PTROLDY(a0),d2
  1164.     move.w    #0,d3
  1165.     move.w    #0,d4
  1166.     bsr    PTR_CLPX
  1167.     bsr    PTR_CLPY
  1168.  
  1169.     sub.w    KV.PTRMINX(a0),d1
  1170.     ext.l    d1
  1171.     divu    d5,d1
  1172.     mulu    d5,d1
  1173.     add.w    KV.PTRMINX(a0),d1
  1174.  
  1175.     sub.w    KV.PTRMINY(a0),d2
  1176.     ext.l    d2
  1177.     divu    d6,d2
  1178.     mulu    d6,d2
  1179.     add.w    KV.PTRMINY(a0),d2
  1180.  
  1181.     move.w    KV.PTROLDX(a0),d3
  1182.     move.w    KV.PTROLDY(a0),d4
  1183.     sub.w    d1,d3
  1184.     sub.w    d2,d4
  1185.     move.w    d1,KV.PTROLDX(a0)
  1186.     move.w    d2,KV.PTROLDY(a0)
  1187.     sub.w    d3,KV.PTRERRX(a0)
  1188.     sub.w    d4,KV.PTRERRY(a0)
  1189.  
  1190.     movem.l    (a7)+,d1/d3-d4
  1191.  
  1192. ; --------------------------------------------------------------
  1193.     BTST    #6,CIAA_PRA    ; left mouse button
  1194.     BNE.S    MOUS9
  1195.     BSET    #6,D1        ; set  space
  1196. MOUS9:
  1197.     MOVE.W    POTGOR,D0
  1198.     AND.W    #$0400,D0    ; right mouse button
  1199.     BNE.S    MOUS10
  1200.     BSET    #0,D1        ; set enter
  1201.  
  1202. MOUS10:
  1203.     MOVEM.L    (A7)+,D0/D2-D5/A0
  1204.     RTS
  1205.  
  1206. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1207. ; Here  we start with the rawkey conversion table
  1208. ; which    is used for the KEYROW function.
  1209. ; The organization is Rownumber,Bitnumber in order
  1210. ; of the Amiga rawkeys
  1211.  
  1212. QLRAWKEY:
  1213.     DC.B    $27,$43,$61,$41,$06,$02,$62,$07
  1214.     DC.B    $60,$50,$65,$55,$35,$15,$FF,$65
  1215.     DC.B    $63,$51,$64,$54,$66,$21,$67,$52
  1216.     DC.B    $57,$45,$30,$20,$FF,$43,$61,$41
  1217.     DC.B    $44,$33,$46,$34,$36,$42,$47,$32
  1218.     DC.B    $40,$37,$27,$10,$FF,$06,$02,$62
  1219.     DC.B    $22,$56,$73,$23,$74,$24,$76,$26
  1220.     DC.B    $76,$22,$75,$FF,$FF,$07,$60,$50
  1221.     DC.B    $16,$11,$53,$10,$10,$13,$11,$FF
  1222.     DC.B    $FF,$FF,$55,$FF,$12,$17,$14,$11
  1223.     DC.B    $01,$03,$04,$00,$05,$01,$03,$04
  1224.     DC.B    $FF,$05,$30,$20,$75,$60,$35,$01
  1225.     DC.B    $70,$70,$31,$71,$72,$72,$71,$71
  1226.     DC.B    $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
  1227.     DC.B    $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
  1228.     DC.B    $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
  1229.  
  1230. QLRAWEND:
  1231.  
  1232. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1233. ;  TRAP #1 with D0=$27 (New to QDOS 3.10 on Amiga)
  1234. ;  D1=address of new QLASCII table
  1235. ;  this is the recommended way to implement foreign
  1236. ;  Language keybords tables!
  1237.  
  1238. MT_ASC:
  1239.     movem.l    a3,-(a7)
  1240.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1241.     move.l    d1,KV.QLASCtbl(a3)
  1242.     movem.l    (a7)+,a3
  1243.  
  1244.     moveq    #0,d0
  1245.  
  1246. ; --------------------------------------------------------------
  1247. ;  exit from TRAP call
  1248.  
  1249. TRAP1_X    movem.l    (a7)+,d7/a5/a6    ; exit from exception
  1250.     rte
  1251.  
  1252. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1253. ; conversion table for translating rawkeycode to ASCII code (QL)
  1254. ; 1) subtract raw key code from 255 (255-(CIAA_SP))
  1255. ; 2) Shift right the result by 1
  1256. ; 3) take QLASCII for no shift mode, QLASC_SH for <Shift>,
  1257. ;    QLASC_CT for <Ctrl>, QLASC_SC for <Shift>+<Ctrl>
  1258. ; 4) read related ASCII code (QL) from table at this offset
  1259.  
  1260. QLASCII:
  1261.  DC.B '`','1','2','3','4','5','6','7','8','9','0',156,39,'\',0,'0'
  1262.  DC.B 'q','w','e','r','t','z','u','i','o','p',135,'+',0,'1','2','3'
  1263.  DC.B 'a','s','d','f','g','h','j','k','l',132,128,'#',0,'4','5','6'
  1264.  DC.B '<','y','x','c','v','b','n','m',44,'.','-',0,0,'7','8','9'
  1265.  DC.B ' ',194,9,10,10,27,202,0,0,0,'-',0,208,216,200,192
  1266.  DC.B 232,236,240,244,248,234,238,242,246,250,91,93,'/','*','+',0
  1267.  
  1268. QLASC_SH:
  1269.  DC.B '~','!','"',182,'$','%','&','/','(',')','=','?','^','|',0,'0'
  1270.  DC.B 'Q','W','E','R','T','Z','U','I','O','P',167,'*',0,'1','2','3'
  1271.  DC.B 'A','S','D','F','G','H','J','K','L',164,160,'^',0,'4','5','6'
  1272.  DC.B '>','Y','X','C','V','B','N','M',';',':','_',0,0,'7','8','9'
  1273.  DC.B 252,194,253,254,254,127,202,0,0,0,'-',0,212,220,204,196
  1274.  DC.B 234,238,242,246,250,232,236,240,244,248,'{','}','/','*','+',0
  1275.  
  1276. QLASC_CT:
  1277.  DC.B 0,145,146,147,148,149,150,151,152,153,144,0,0,188,0,'0'
  1278.  DC.B 17,23,5,18,20,26,21,9,15,16,0,0,0,'1','2','3'
  1279.  DC.B 1,19,4,6,7,8,10,11,12,0,0,0,0,'4','5','6'
  1280.  DC.B 0,25,24,3,22,2,14,13,140,142,141,0,0,'7','8','9'
  1281.  DC.B ' ',194,9,10,10,128,202,0,0,0,'-',0,210,218,202,194
  1282.  DC.B 233,237,241,245,249,235,239,243,247,251,91,93,'/','*','+',0
  1283.  
  1284. QLASC_SC:
  1285.  DC.B '`',129,160,131,132,133,0,0,138,136,137,0,0,28,0,'0'
  1286.  DC.B 177,183,165,178,180,186,181,169,175,176,0,0,0,'1','2','3'
  1287.  DC.B 161,179,164,166,167,168,170,171,172,0,0,0,0,'4','5','6'
  1288.  DC.B 0,185,184,163,182,162,174,173,156,158,0,0,0,'7','8','9'
  1289.  DC.B ' ',194,9,10,10,27,202,0,0,0,'-',0,214,222,206,198
  1290.  DC.B 235,239,243,247,251,233,237,241,245,249,91,93,'/','*','+',0
  1291.  
  1292. QLASCEND:
  1293.  
  1294. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1295. ;  BASIC extensions specific to AMIGA QDOS
  1296.  
  1297. PROC_DEF:
  1298.     dc.w    5
  1299.     dc.w    B_KEYDT-*
  1300.     dc.b    5,'KEYDT'
  1301.     dc.w    B_PTR_POS-*
  1302.     dc.b    7,'PTR_POS'
  1303.     dc.w    B_PTR_INC-*
  1304.     dc.b    7,'PTR_INC'
  1305.     dc.w    B_PTR_LIMITS-*
  1306.     dc.b    10,'PTR_LIMITS',0
  1307.  
  1308.     dc.w    0
  1309.  
  1310.     dc.w    2
  1311.     dc.w    B_PTR_X-*
  1312.     dc.b    6,'PTR_X%',0
  1313.     dc.w    B_PTR_Y-*
  1314.     dc.b    6,'PTR_Y%',0
  1315.  
  1316.     dc.w    0
  1317.  
  1318. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1319. ;  BASIC proc to link in German keymap again, should it become
  1320. ;  dislocated for some reason.
  1321.  
  1322. B_KEYDT:
  1323.     lea    QLASCII(pc),a0    ; address of keyboard table
  1324.     move.l    a0,d1        ; in d1
  1325.     moveq    #$27,d0        ; MT_ASC (Amiga-QDOS 3.10
  1326.     trap    #1        ; and later, only)
  1327.     rts
  1328.  
  1329. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1330. B_PTR_LIMITS:
  1331.     moveq    #0,d2
  1332.     moveq    #0,d3
  1333.     move.w    #255,d4
  1334.     move.w    #255,d5
  1335.     cmp.l    a3,a5
  1336.     beq.s    PTR_LIMITS
  1337.  
  1338.     bsr    FETCH_W
  1339.     bne    B_PTRLIMX
  1340.  
  1341.     cmp.w    #0,d1
  1342.     blt    RPRT_BP
  1343.  
  1344.     move.w    d1,d2        ; min X
  1345.  
  1346.     bsr    FETCH_W
  1347.     bne    B_PTRLIMX
  1348.  
  1349.     cmp.w    #0,d1
  1350.     blt    RPRT_BP
  1351.  
  1352.     move.w    d1,d3        ; min Y
  1353.  
  1354.     bsr    FETCH_W
  1355.     bne    B_PTRLIMX
  1356.  
  1357.     cmp.w    #255,d1
  1358.     bgt    RPRT_BP
  1359.  
  1360.     move.w    d1,d4        ; max X
  1361.  
  1362.     bsr    FETCH_W
  1363.     bne    B_PTRLIMX
  1364.  
  1365.     cmp.w    #255,d1
  1366.     bgt    RPRT_BP
  1367.  
  1368.     move.w    d1,d5        ; max Y
  1369.  
  1370.     cmp.l    a3,a5
  1371.     bne    RPRT_BP
  1372.  
  1373. PTR_LIMITS:
  1374.     cmp.w    d2,d4
  1375.     ble    RPRT_BP
  1376.  
  1377.     cmp.w    d3,d5
  1378.     ble    RPRT_BP
  1379.  
  1380.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1381.  
  1382.     move.w    d2,KV.PTRMINX(a3)
  1383.     move.w    d3,KV.PTRMINY(a3)
  1384.     move.w    d4,KV.PTRMAXX(a3)
  1385.     move.w    d5,KV.PTRMAXY(a3)
  1386.  
  1387.     sub.w    d2,d4
  1388.     addq.w    #1,d4
  1389.     lsr.w    #1,d4
  1390.  
  1391.     move.w    KV.PTRINCX(a3),d0
  1392.     cmp.w    d4,d0
  1393.     ble.s    B_PTRLIM1
  1394.  
  1395.     move.w    d4,KV.PTRINCX(a3)
  1396.  
  1397. B_PTRLIM1:
  1398.     sub.w    d3,d5
  1399.     addq.w    #1,d5
  1400.     lsr.w    #1,d5
  1401.  
  1402.     move.w    KV.PTRINCY(a3),d0
  1403.     cmp.w    d5,d0
  1404.     ble.s    B_PTRLIM2
  1405.  
  1406.     move.w    d4,KV.PTRINCY(a3)
  1407.  
  1408. B_PTRLIM2:
  1409.     move.w    KV.PTRX(a3),d1
  1410.     move.w    KV.PTRY(a3),d2
  1411.  
  1412.     bsr    PTR_CLPX
  1413.     bsr    PTR_CLPY
  1414.  
  1415.     move.w    d1,KV.PTRX(a3)
  1416.     move.w    d2,KV.PTRY(a3)
  1417.  
  1418.     bsr    PTR_POS
  1419.  
  1420.     move.w    d1,KV.PTROLDX(a3)
  1421.     move.w    d2,KV.PTROLDY(a3)
  1422.  
  1423.     move.w    #0,KV.PTRERRX(a3)
  1424.     move.w    #0,KV.PTRERRY(a3)
  1425.  
  1426.     moveq    #0,d0
  1427.  
  1428. B_PTRLIMX:
  1429.     rts
  1430.  
  1431. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1432. B_PTR_POS:
  1433.     moveq    #0,d1
  1434.     moveq    #0,d2
  1435.     cmp.l    a3,a5
  1436.     beq.s    B_PTR_POS1
  1437.  
  1438.     bsr    FETCH_W
  1439.     bne.s    B_PTR_POSX
  1440.  
  1441.     move.w    d1,d2
  1442.  
  1443.     bsr    FETCH_W
  1444.     bne.s    B_PTR_POSX
  1445.  
  1446.     cmp.l    a3,a5
  1447.     bne    RPRT_BP
  1448.  
  1449.     exg    d1,d2
  1450.  
  1451. B_PTR_POS1:
  1452.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1453.  
  1454.     bsr    PTR_CLPX
  1455.     bsr    PTR_CLPY
  1456.  
  1457.     move.w    d1,KV.PTRX(a3)
  1458.     move.w    d2,KV.PTRY(a3)
  1459.  
  1460.     bsr    PTR_POS
  1461.  
  1462.     move.w    d1,KV.PTROLDX(a3)
  1463.     move.w    d2,KV.PTROLDY(a3)
  1464.  
  1465.     move.w    #0,KV.PTRERRX(a3)
  1466.     move.w    #0,KV.PTRERRY(a3)
  1467.  
  1468.     moveq    #0,d0
  1469.  
  1470. B_PTR_POSX:
  1471.     rts
  1472.  
  1473. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1474. B_PTR_INC:
  1475.     moveq    #4,d1
  1476.     moveq    #8,d2
  1477.     cmp.l    a3,a5
  1478.     beq.s    B_PTR_INC1
  1479.  
  1480.     bsr    FETCH_W
  1481.     bne.s    B_PTR_INCX
  1482.  
  1483.     move.w    d1,d2
  1484.  
  1485.     bsr    FETCH_W
  1486.     bne.s    B_PTR_INCX
  1487.  
  1488.     cmp.l    a3,a5
  1489.     bne    RPRT_BP
  1490.  
  1491.     exg    d1,d2
  1492.  
  1493. B_PTR_INC1:
  1494.     bsr    PTR_INC
  1495.  
  1496.     moveq    #0,d0
  1497.  
  1498. B_PTR_INCX:
  1499.     rts
  1500.  
  1501. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1502. B_PTR_X:
  1503.     cmp.l    a3,a5
  1504.     bne    RPRT_BP
  1505.  
  1506.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1507.  
  1508.     move.w    KV.PTRX(a3),d1
  1509.  
  1510.     bra    RET_W
  1511.  
  1512. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1513. B_PTR_Y:
  1514.     cmp.l    a3,a5
  1515.     bne    RPRT_BP
  1516.  
  1517.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1518.  
  1519.     move.w    KV.PTRY(a3),d1
  1520.  
  1521.     bra    RET_W
  1522.  
  1523. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1524. PTR_POS:
  1525.     movem.l    d1-d3,-(a7)
  1526.  
  1527.     add.w    #$2C,d2        ; Y offset $2C
  1528.     andi.w    #$1FF,d2     ; Y within range
  1529.     move.w    d2,d3
  1530.     lsl.l    #8,d3
  1531.     lsl.l    #1,d3
  1532.     addi.w    #$A0,d1        ; X offset $A0
  1533.     andi.w    #$1FF,d1     ; X within range
  1534.     or.w    d1,d3
  1535.     ror.l    #1,d3
  1536.     swap    d3
  1537.     addi.w    #$10,d2        ; Height $10
  1538.     lsl.w    #8,d2
  1539.     roxl.w    #1,d3
  1540.     roxl.w    #1,d3
  1541.     or.w    d2,d3
  1542.  
  1543.     move.l    d3,SPRLST
  1544.  
  1545.     movem.l    (a7)+,d1-d3
  1546.  
  1547. PTR_POSX:
  1548.     rts
  1549.  
  1550. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1551. PTR_CLPX:
  1552.     movem.l    d5/a3,-(a7)
  1553.  
  1554.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1555.  
  1556.     move.w    KV.PTRMINX(a3),d5
  1557.     cmp.w    d5,d1
  1558.     blt.s    PTR_CLP1
  1559.  
  1560.     move.w    KV.PTRMAXX(a3),d5
  1561.     cmp.w    d5,d1
  1562.     bgt.s    PTR_CLP1
  1563.  
  1564.     moveq    #0,d3
  1565.     bra.s    PTR_CLP2
  1566.  
  1567. PTR_CLP1:
  1568.     add.w    d1,d3
  1569.     sub.w    d5,d3
  1570.  
  1571.     move.w    d5,d1
  1572.  
  1573. PTR_CLP2:
  1574.     movem.l    (a7)+,d5/a3
  1575.     rts
  1576.  
  1577. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1578. PTR_CLPY:
  1579.     movem.l    d5/a3,-(a7)
  1580.  
  1581.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1582.  
  1583.     move.w    KV.PTRMINY(a3),d5
  1584.     cmp.w    d5,d2
  1585.     blt.s    PTR_CLP3
  1586.  
  1587.     move.w    KV.PTRMAXY(a3),d5
  1588.     cmp.w    d5,d2
  1589.     bgt.s    PTR_CLP3
  1590.  
  1591.     moveq    #0,d4
  1592.     bra.s    PTR_CLP4
  1593.  
  1594. PTR_CLP3:
  1595.     add.w    d2,d4
  1596.     sub.w    d5,d4
  1597.  
  1598.     move.w    d5,d2
  1599.  
  1600. PTR_CLP4:
  1601.     movem.l    (a7)+,d5/a3
  1602.     rts
  1603.  
  1604. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1605. PTR_INC:
  1606.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1607.  
  1608.     tst.w    d1
  1609.     beq.s    PTR_INCX
  1610.  
  1611.     move.w    KV.PTRMAXX(a3),d0
  1612.     sub.w    KV.PTRMINX(a3),d0
  1613.     addq.w    #1,d0
  1614.     lsr.w    #1,d0
  1615.  
  1616.     cmp.w    d0,d1
  1617.     bgt.s    PTR_INCX
  1618.  
  1619. PTR_INC1:
  1620.     tst.w    d2
  1621.     beq.s    PTR_INCX
  1622.  
  1623.     move.w    KV.PTRMAXY(a3),d0
  1624.     sub.w    KV.PTRMINY(a3),d0
  1625.     addq.w    #1,d0
  1626.     lsr.w    #1,d0
  1627.  
  1628.     cmp.w    d0,d2
  1629.     bgt.s    PTR_INCX
  1630.  
  1631.     move.w    d1,KV.PTRINCX(a3)
  1632.     move.w    d2,KV.PTRINCY(a3)
  1633.  
  1634. PTR_INCX:
  1635.     moveq    #0,d0
  1636.  
  1637.     rts
  1638.  
  1639. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1640. ; Fetch one Word
  1641.  
  1642. FETCH_W:
  1643.     movem.l    a2,-(a7)
  1644.  
  1645.     move.w    CA.GTINT,a2
  1646.     bsr.s    GET_ONE
  1647.     bne.s    FETCH_WX
  1648.  
  1649.     move.l    a1,BV_RIP(a6)
  1650.     moveq    #0,d1
  1651.     move.w    0(a6,a1.l),d1
  1652.     addq.l    #2,BV_RIP(a6)
  1653.  
  1654. FETCH_WX:
  1655.     movem.l    (a7)+,a2
  1656.     tst.l    d0
  1657.     rts
  1658.  
  1659. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1660. ;  This routine gets one parameter and returns it on the maths
  1661. ;  stack, pointed to by (A1).
  1662. ;
  1663. ; Entry: A2.L   routine to call (i.e. CA.GTINT)
  1664. ;    A3.L   pointer to first parameter
  1665. ;    A5.L   pointer to last parameter
  1666. ;
  1667. ; Exit:    A3.L   updated
  1668. ;    A5.L   updated
  1669. ;    A1.L   updated pointer to top of maths stack
  1670. ;    D0.L   error code
  1671.  
  1672. GET_ONE:
  1673.     movem.l    d1-d6/a0/a2,-(a7)
  1674.  
  1675.     lea    8(a3),a0
  1676.     cmp.l    a0,a5
  1677.     blt.s    GET_ONEBp
  1678.  
  1679.     move.l    BV_RIP(a6),a1
  1680.     move.l    a5,-(a7)
  1681.     move.l    a0,a5
  1682.     move.l    a5,-(a7)
  1683.     jsr    (a2)
  1684.     movem.l    (a7)+,a0/a5
  1685.  
  1686.     tst.l    d0
  1687.     bne.s    GET_ONEX
  1688.  
  1689.     move.l    a0,a3
  1690.     move.l    a1,BV_RIP(a6)
  1691.  
  1692.     bra.s    GET_ONEX
  1693.  
  1694. GET_ONEBp:
  1695.     moveq    #ERR.BP,d0
  1696.  
  1697. GET_ONEX:
  1698.     movem.l    (a7)+,d1-d6/a0/a2
  1699.     tst.l    d0
  1700.     rts
  1701.  
  1702. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1703. ;  Return word d1.w to BASIC
  1704.  
  1705. RET_W:
  1706.     move.l    d1,d4
  1707.     moveq.l    #2,d1
  1708.     move.w    BV.CHRIX,a2
  1709.     jsr    (a2)
  1710.     move.l    d4,d1
  1711.  
  1712.     move.l    BV_RIP(a6),a1    ; Get arith stack pointer
  1713.     subq.l    #2,a1        ; room for 2 bytes
  1714.     move.l    a1,BV_RIP(a6)
  1715.     move.w    d1,0(a6,a1.l)    ; Put int number on stack
  1716.     moveq.l    #3,d4        ; set Integer type
  1717.  
  1718.     moveq.l    #ERR.OK,d0    ; no errors
  1719.     rts
  1720.  
  1721. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1722. RPRT_BP:
  1723.     moveq    #ERR.BP,d0
  1724.     rts
  1725.  
  1726. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1727.     END
  1728.